home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / akcl1615.lha / doc / find-doc.el < prev    next >
Text File  |  1991-08-26  |  13KB  |  447 lines
  1.  
  2. ;; This file sets up machinery to build a doc string file from
  3. ;; a number of lisp files.  Then it allows building of key pointers
  4. ;; into that file.  These can be used to complete and view documentation
  5. ;; in emacs.  I have tried to emulate the usage pattern of the tags facility
  6. ;; in order to make the doc facility easier to use.
  7. ;;  edoc <--> etags
  8. ;;  DOC  <--> TAGS
  9. ;;  visit-doc-file <--> visit-tags-table
  10. ;;  C-h d  <--> M-.
  11.  
  12. ;; To create the doc strings file use edoc.
  13. ;; Usage: 
  14. ;; % edoc *.lisp
  15. ;; This creates a DOC file and a DOC-keys.el file.
  16. ;; Normally comments which appear where a doc string would have
  17. ;; been, will be used instead of the doc string.  Also comments
  18. ;; preceding or following a defvar will be used depending
  19. ;; on the setting of the variable comments-for-defvar.
  20. ;; You may set that variable in a .edoc file.
  21. ;; For c files you may use the appropriate primitive in emacs/etc
  22. ;; in order to create the DOC file.
  23. ;; For a lisp system for which you do not have sources (why are you using it!),
  24. ;; you may build a DOC file using the common lisp function doc-file
  25. ;; provided in this file.  You must then use the snarf-doc command, to
  26. ;; build the keys into the DOC file you have just created.
  27. ;; You may concatenate two DOC files.  Again you must use snarf-doc,
  28. ;; to build the keys.
  29.  
  30. ;; To use the documentation so created do
  31. ;; M-x visit-doc-file to set up for using a particular DOC file.
  32. ;; Then C-hd (find-doc) will allow you to query the doc data base.
  33.  
  34.  
  35. (defvar comments-for-defvar 'after)
  36. ;; If nil only use comments inside the defvar,
  37. ;; If the symbol 'after use comment following, and if 'before
  38. ;; use the comment before.
  39.  
  40. (defvar doc-start "")
  41. ;; The special string which starts each doc record. key used
  42. (defvar doc-key-length 1)
  43. ;; The length of the description immediately following doc-start
  44. ;; which says if this is a function,...:  This field contains
  45. ;; F for function or M for macro V for variable,...
  46.  
  47.  
  48. (defvar find-doc-name)
  49. (defvar find-doc-args)
  50. ;Used internally by find-doc-args.
  51.  
  52. (defvar include-all-functions-and-args nil)
  53. ;;If t all functions, not just those with documentation, will be included.
  54. (defvar include-args t)
  55. ;;If t a macro or function's args will be included.
  56.  
  57. ;;Set up the common lisp syntax table.
  58. (defvar common-lisp-syntax-table (copy-syntax-table lisp-mode-syntax-table))
  59.  
  60. (let* ((const "!$%&*+-./0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz[]^_{}~")
  61.        (i 0))
  62.   (while (< i (length const))
  63.     (modify-syntax-entry (aref const i) "w" common-lisp-syntax-table)
  64.     (setq i (1+ i))))
  65.  
  66.  
  67. (defun forward-over-white()
  68.   (while (looking-at "[     \n]")
  69.     (forward-char 1)))
  70.  
  71. (defun back-over-white()
  72.   (let (tem)
  73.   (while (looking-at "[     \n]")
  74.     (setq tem t)
  75.     (forward-char -1))
  76.   (if tem (forward-char 1))
  77.   ))
  78.  
  79.  
  80. (defun make-doc (file out)
  81.   "Create documentation for file"
  82.   (find-file file)
  83.   (let ((file-buf (current-buffer)))
  84.   (if buffer-read-only (toggle-read-only))
  85.   (goto-char (point-min))
  86.   (set-syntax-table common-lisp-syntax-table)
  87.   (setq doc-buf (generate-new-buffer "doc-buf"))
  88.   (while (re-search-forward "^(def"  nil t)
  89.           (condition-case er
  90.           (parse-one-def out)
  91.         (error  (end-of-line) er)))
  92.   (set-buffer-modified-p nil)
  93.   (kill-buffer file-buf)
  94.    doc-buf
  95.    
  96.     ))
  97.  
  98.  
  99. (defun make-all-doc (out-file  file-list)
  100. ;Write doc strings to OUT-FILE for all files in FILE-LIST.
  101. ;Currently lisp syntax is assumed for files in file-list.
  102.  
  103.   (if (file-exists-p out-file) (delete-file out-file))
  104.   (while file-list
  105.     (setq file (car file-list))
  106.     (message (format "for %s.."file))
  107.     (setq buf (make-doc file nil))
  108.     (switch-to-buffer buf)
  109.     (append-to-file (point-min) (point-max) out-file)
  110.     (kill-buffer buf)
  111.     (setq file-list (cdr file-list))
  112.     ))
  113.  
  114. (global-set-key "d" 'find-doc)
  115. (global-set-key "/" 'apropos-doc)
  116.  
  117.  
  118. (defun apropos-doc (test)
  119.   (interactive "sApropos doc string: ")
  120.   (require-doc-file)
  121.   (let  (ans (alist my-lisp-doc))
  122.     (while alist
  123.       (cond ((string-match test (car  (car alist)))
  124.          (setq ans (cons (car (car alist)) ans))))
  125.       (setq alist (cdr alist)))
  126.     (with-output-to-temp-buffer "*Completions*"
  127.       (display-completion-list ans))))
  128.  
  129.  
  130.  
  131. (defun string-next-sexp (pt)
  132.   (save-excursion
  133.     (goto-char pt)
  134.     (let ((beg pt)
  135.       (end (progn (forward-sexp 1) (point)))
  136.       )
  137.       (goto-char beg)
  138.       (cond ((and (looking-at "(")
  139.           (re-search-forward  "\\b&aux" end t))
  140.          (forward-char (- (length "&aux")))
  141.          (skip-chars-backward "     \n")
  142.          (concat (buffer-substring beg (point))
  143.              ")"))
  144.         (t(buffer-substring beg end))))))
  145.  
  146.  
  147.  
  148.  
  149.  
  150. (defun skip-to-doc (type)
  151.   (forward-char 2)
  152.   (setq find-doc-name (progn (forward-sexp 1)
  153.                  (forward-over-white) (point)))
  154.   (cond ((equal type "V")
  155.      (forward-sexp 1) ;skip the name
  156.      (forward-over-white)
  157.      (or (looking-at ")") (forward-sexp 1))
  158.      (forward-over-white)
  159.      (cond ((and  comments-for-defvar
  160.              (looking-at ")"))
  161.         (cond ((eq comments-for-defvar 'after)
  162.                (forward-char 1)
  163.                (forward-over-white))
  164.               ((eq comments-for-defvar 'before)
  165.                (goto-char find-doc-name)
  166.                (previous-line 1)
  167.                (back-over-white)
  168.                (beginning-of-line)
  169.                
  170.                ))))
  171.      (setq find-doc-args nil))
  172.     (t 
  173.      (setq find-doc-args
  174.            (progn (forward-sexp 1)(forward-over-white) (point)))
  175.      ;skip name
  176.      
  177.      (forward-sexp 1)  (forward-over-white) ;skip the args
  178.     ))
  179.   (read-doc type)
  180.   )
  181.  
  182. (defun parse-one-def (out)
  183.   (let (name)
  184.     (beginning-of-line)
  185.     (cond ((looking-at "(defun")
  186.        (skip-to-doc "F"))
  187.       ((looking-at "(defmacro")
  188.         (skip-to-doc "M"))
  189.       ((or (looking-at "(defvar")
  190.            (looking-at "(defconstant")
  191.            (looking-at "(defparameter"))
  192.        (skip-to-doc "V"))
  193.       )
  194.     (end-of-line)
  195.     ))
  196.  
  197. (defvar find-doc-comment-start nil)
  198. (defun mark-very-long-comment ()
  199.   (interactive)
  200. ;  (mm "call mark comment at %d" (point))
  201.  
  202.   (setq comment-start (or find-doc-comment-start comment-start))
  203.   (let ((at (point)))
  204.     (beginning-of-line)
  205.     (while(and (not (eobp))
  206.            (or  (looking-at comment-start)
  207.             (looking-at "[     ]*\n")
  208.            ))
  209.       (forward-line 1))
  210.     (back-over-white)
  211.     (set-mark (point))
  212.     (goto-char at)
  213.     (while(and (not (bobp))
  214.            (or (looking-at comment-start)
  215.             (looking-at "[     ]*\n")
  216.             ))
  217.       (forward-line -1))
  218.     (if (not (looking-at comment-start))(forward-line 1))
  219.     (forward-over-white)
  220.     ))
  221.  
  222.  
  223. (defmacro mm (&rest b)
  224.   (list 'progn (list 'message (cons  'format b)) '(sleep-for 1)))
  225. ;;narrows to the long-comment, and removes the ;
  226. (defun copy-long-comment (to-buf)
  227.   (mark-very-long-comment)
  228.   (let ((beg (min (dot) (mark)))
  229.     (end (max (dot) (mark))) (n 0)m)
  230. ;    (mm "Beg %d end %d" beg end)
  231.     (narrow-to-region beg end)
  232.     (goto-char (point-min))
  233.     (forward-over-white)
  234.     (let ((tem (point)))
  235. ;      (mm "check at %d" tem)
  236.       (while (looking-at ";")
  237.     (forward-char 1))
  238.       (setq n (- (point) tem)))
  239.     (goto-char (point-min))
  240.     (while (not (eobp))
  241.       (setq m n)
  242.       (while (> m  0)
  243.     (cond (;(looking-at ";")
  244.            (looking-at comment-start)
  245.            (delete-char 1)
  246.            (cond ((looking-at " ")(delete-char 1)(setq m 0)))
  247.            (setq m (- m 1)))
  248.           (t (setq m 0))))
  249.       (forward-line 1)))
  250.         (my-copy-to-buffer 
  251.      doc-buf (point-min) (point-max))
  252.     (widen)
  253.     )
  254.  
  255. (defun my-copy-to-buffer (buf beg end)
  256.   (let ((tem (current-buffer)))
  257.     (switch-to-buffer buf)
  258.     (insert-buffer-substring tem beg end)
  259.     (switch-to-buffer tem)))
  260.  
  261.  
  262. (defun write-doc (string)
  263.   (let ((buf (current-buffer)))
  264.     (switch-to-buffer doc-buf)
  265.     (goto-char (point-max))
  266.     (insert string)
  267.     (switch-to-buffer buf)))
  268.  
  269. (defun write-doc-string-begin  (type)
  270.   (let ((name  (string-next-sexp find-doc-name))
  271.     (args  (if find-doc-args (string-next-sexp find-doc-args))))
  272.     (let ((buf (current-buffer)))
  273.       (switch-to-buffer doc-buf)
  274.       (goto-char (point-max))
  275.       (insert doc-start type name)
  276.       (insert (cdr (assoc type
  277.               '(("F" . "\n Function ")
  278.                 ("M" . "\n Macro ")
  279.                 ("T" . "\n Topic ")
  280.                 ("V" . "\n Variable: ")))))
  281.       (cond ((and args include-args)
  282.          (insert "Args: " args "\n"))
  283.         (t (insert "\n")))
  284.       (switch-to-buffer buf)
  285.       )))
  286.   
  287. (defun read-doc (type)
  288.   "Reads the documentation and puts in doc file"
  289.   (skip-chars-forward "     \n" )
  290.   (cond ((looking-at comment-start)
  291.      (write-doc-string-begin type)
  292.      (copy-long-comment doc-buf))
  293.     ((looking-at "\"")
  294.          (let ((tem (point))
  295.            (end (progn (forward-sexp 1)(point))))
  296.        (write-doc-string-begin type)
  297.        (my-copy-to-buffer doc-buf (+ 1 tem) (-  end 1))))
  298.     (include-all-functions-and-args
  299.      (write-doc-string-begin type))))
  300.  
  301.  
  302. (defun snarf-doc (file)
  303.   "Takes a doc string file, and records the pointers into that file.
  304. It writes out a list of doc pointers into file-keys.el.  The list is suitable
  305. for the find-doc command."
  306.   (interactive "FMake -keys.el for file: ")
  307.   (find-file file)
  308.   (set-syntax-table common-lisp-syntax-table)
  309.   (goto-char (point-min))
  310.   (let (tem lis)
  311.     (while (search-forward doc-start nil t)
  312.       (setq tem (point))
  313.       (setq lis (cons
  314.          (cons (buffer-substring (setq tem (+ doc-key-length tem))
  315.                      (progn (forward-sexp 1) (point)))
  316.                (- tem 1)
  317.                )
  318.          lis)))
  319.     (let ((buf (generate-new-buffer "-keys.el"))(tem lis))
  320.       (switch-to-buffer buf)
  321.       (insert "(setq my-lisp-doc '(")
  322.       (while tem
  323.     (prin1 (car tem) buf)
  324.     (terpri buf)
  325.     (setq tem (cdr tem))
  326.     )
  327.       (insert "))")
  328.       (write-file (concat file "-keys.el")))
  329.     (setq my-lisp-doc lis)))
  330.  
  331. (defvar find-doc-buffer nil)
  332. ; buffer where the lisp documentation lives
  333.  
  334. (defvar doc-file-name nil)
  335. ; File name of the current doc file.  Usually ../DOC should be used
  336. ; and ../DOC-keys.el will hold the keys to the file.
  337.  
  338.  
  339. (defun visit-doc-file (file)
  340.   (interactive (list (read-file-name "Visit doc table: (default DOC) "
  341.                      default-directory
  342.                      (concat default-directory "DOC")
  343.                      t)))
  344.   (setq file (expand-file-name file))
  345.   (if (file-directory-p file)
  346.       (setq file (concat file "DOC")))
  347.   (setq doc-file-name file)
  348.   (load (concat file "-keys.el")))
  349.  
  350. (defun require-doc-file()
  351.   (or doc-file-name
  352.       (visit-doc-file    (read-file-name "Visit doc table: (default DOC) "
  353.                      default-directory
  354.                      (concat default-directory "DOC")
  355.                      t))))
  356. (defvar find-doc-edit nil "If non nil, instead of just printing out
  357. a copy of the documentation in the other window, we actually visit
  358. the DOC file.  This is useful for editing it.")
  359. (defun find-doc()
  360.   (interactive)
  361.   (require-doc-file)
  362.   (require 'shell)
  363.   
  364.   (or find-doc-edit(and find-doc-buffer (get-buffer-process find-doc-buffer))
  365.       (progn (setq find-doc-buffer
  366.            (make-shell "find-doc"
  367.                    "/bin/sh" nil "-i"))
  368.          (sleep-for 2)
  369.          (send-string (get-buffer-process find-doc-buffer)
  370.               "PS1=\n \n")
  371.          ))
  372.   
  373.   (let (tem result (completion-ignore-case  t))
  374.     (save-excursion
  375.       (condition-case er
  376.       (progn
  377.         (forward-sexp -1)
  378.         (setq tem
  379.           (buffer-substring (point) (progn (forward-sexp 1) (point)))))
  380.     (error)))
  381.     (or (and tem (assoc (setq tem (upcase tem)) my-lisp-doc))
  382.     (setq tem nil))
  383.     (let ((symbol (completing-read "Describe symbol: "
  384.                    my-lisp-doc nil t tem)))
  385.       (setq result (assoc symbol my-lisp-doc))
  386.       (or result
  387.       (setq result (assoc (downcase symbol) my-lisp-doc)))
  388.       (or result
  389.       (setq result (assoc (upcase symbol) my-lisp-doc)))
  390.       (or result (error (format "case mix up: %s not in my-lisp-doc keys" symbol))))
  391.        
  392.  
  393.     (cond (find-doc-edit
  394.          (find-file-other-window doc-file-name)
  395.          (goto-char (cdr result))
  396.          (set-fill-column 79)
  397.          (cond ((looking-at (concat "[A-Z]"
  398.                     (car result)))
  399.             (recenter 0)
  400.             )
  401.            (t (goto-char (point-min))
  402.               (re-search-forward (concat "[A-Z\n]" (car result) "\\b"))
  403.               (recenter 0)
  404.               ))
  405.          )
  406.       ( t
  407.         (let ((old (current-buffer)))
  408.           (switch-to-buffer find-doc-buffer)
  409.           (erase-buffer)
  410.           (goto-char (point-max))
  411.           (send-string  (get-buffer-process find-doc-buffer)
  412.                 "echo Documentation: \n"
  413.                 )
  414.  
  415.           (process-send-string (get-buffer-process find-doc-buffer)
  416.                    (format "print_doc %s %d \n"
  417.                        doc-file-name (cdr result)))
  418.           (switch-to-buffer old)
  419.       
  420.           (display-buffer find-doc-buffer)
  421.           result)))))
  422.  
  423.  
  424. ;;common lisp for creating a doc file.
  425.  
  426.  
  427.  
  428. (defun doc-file (file packages)
  429. ;;Write FILE of doc strings for all symbols in PACKAGES
  430. ;;This file is suitable for use with the find-doc function.  
  431.   (with-open-file (st file :direction :output)
  432.    (sloop:sloop
  433.     for v in packages
  434.     do (sloop:sloop
  435.     for w in-package (if (packagep v) (package-name v) v)
  436.     when  (setq doc (documentation w 'function))
  437.     do (format st "F~a~%~a~a" w
  438.            (cond ((special-form-p w) "Special Form: ")
  439.              ((functionp w) "Function: ")
  440.              ((macro-function w) "Macro: ")
  441.              (t ""))
  442.            doc)
  443.     when (setq doc (documentation w 'variable))
  444.     do (format st "VVariable:~a~%~a" w doc)
  445.     ))))
  446.  
  447.